home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 2 / Gold Medal Software Volume 2 (Gold Medal) (1994).iso / utils / rdate115.arj / REDATE!.PAS < prev    next >
Pascal/Delphi Source File  |  1993-09-28  |  8KB  |  263 lines
  1. program setfiletime;
  2. {------------------------------------------------------------------------------
  3.  
  4.                                 REVISION HISTORY
  5.  
  6. v1.00  : 1993/07/14.  First public release.  DDA
  7. v1.10  : 1993/09/07.  Added support for single field specification,
  8.                             suggestion and assistance from Don Dougherty.  DDA
  9.                       Added support for century.
  10.                             (Set century=2000 for 20th century dates.)  DDA
  11. v1.10a : 1993/09/09.  Now specifying seconds is optional, default is :00  DDA
  12. v1.11  : 1993/09/13.  Added "/p": prompt for date, time doesn't change.  DDA
  13. v1.15  : 1993/09/28.  Increased date & time specification flexibility.  DDA
  14.  
  15. ------------------------------------------------------------------------------}
  16.  
  17. uses dos;
  18. var
  19.    dirinfo : searchrec ;
  20.    ps2     : string ;
  21.    century : word ;
  22.  
  23. procedure showhelp ( errornum : byte );
  24. const
  25.     progdata = 'REDATE!- Free DOS utility: file redater.';
  26.     progdat2 = 'V1.15: September 28, 1993. (c) 1993 by David Daniel Anderson - Reign Ware.';
  27.  
  28.     usage = 'Usage: REDATE! file(s) [mm/dd/yy (or) mm-dd-yy] [hh:mm[:ss]]';
  29.     usag2 = '  or : REDATE! file(s) /p  (prompt for date, time doesn''t change)';
  30. var
  31.     message : string [80];
  32. begin
  33.     writeln ( progdata );
  34.     writeln ( progdat2 );
  35.     writeln ;
  36.     writeln ( usage );
  37.     writeln ( usag2 );
  38.     writeln ;
  39.  
  40.     case errornum of
  41.       1 : message := 'you must specify -exactly- one filespec (wildcards are OK).';
  42.       2 : message := 'too many parameters.';
  43.       3 : message := 'non-numeric found in a date or time string!';
  44.     end;
  45.     writeln ( 'ERROR: (#',errornum,') - ', message );
  46.     halt ( errornum );
  47. end;
  48.  
  49. function leadingzero ( w : word ) : string ;
  50. var
  51.   s : string ;
  52. begin
  53.   str (w:0,s);
  54.   if length (s) = 1 then
  55.     s := '0' + s;
  56.   leadingzero := s;
  57. end;
  58.  
  59. procedure parsedate ( dates : string ; var cdt : longint );
  60. var
  61.      date_time : datetime;
  62.      valerr : integer ;
  63. begin
  64.      if ( length ( dates ) = 7 ) then
  65.         dates := '0'+dates;
  66.      with date_time do
  67.      begin
  68.           val ( copy ( dates ,1,2 ), month, valerr );
  69.               if valerr <> 0 then showhelp (3);
  70.           val ( copy ( dates ,4,2 ), day,   valerr );
  71.               if valerr <> 0 then showhelp (3);
  72.           val ( copy ( dates ,7,2 ), year,  valerr );
  73.               if valerr <> 0 then showhelp (3);
  74.           year := century + year;
  75.      end;
  76.      packtime ( date_time, cdt );
  77. end;
  78.  
  79. procedure parsetime ( times : string ; var cdt : longint );
  80. var
  81.      date_time : datetime;
  82.      valerr : integer ;
  83. begin
  84.      if (( length ( times ) = 4 )
  85.       or ( length ( times ) = 7 )) then
  86.         times := '0'+times;
  87.      if ( length ( times ) = 5 ) then
  88.         times := times + ':00' ;
  89.      with date_time do
  90.      begin
  91.           val ( copy ( times ,1,2 ), hour, valerr );
  92.               if valerr <> 0 then showhelp (3);
  93.           val ( copy ( times ,4,2 ), min,  valerr );
  94.               if valerr <> 0 then showhelp (3);
  95.           val ( copy ( times ,7,2 ), sec,  valerr );
  96.               if valerr <> 0 then showhelp (3);
  97.      end;
  98.      packtime ( date_time, cdt );
  99. end;
  100.  
  101. procedure get_dt ( var cur_dt : longint );
  102. var
  103.     y,mo,d,w,
  104.     h,mi,s,u  : word;
  105.     date_time : datetime;
  106. begin
  107.      getdate (y,mo,d,w);
  108.      gettime (h,mi,s,u);
  109.      with date_time do
  110.      begin
  111.           YEAR := y;  MONTH := mo;  DAY := d;
  112.           HOUR := h;  MIN   := mi;  SEC := s;
  113.      end;
  114.      packtime ( date_time, cur_dt );
  115. end;
  116.  
  117. function extract_file_date ( fname : string ) : string ;
  118. var
  119.     afile : file ;
  120.     fdate : longint ;
  121.     dtt   : datetime ;
  122.     dstr  : string ;
  123. begin
  124.      assign (afile, fname);
  125.      reset (afile);
  126.      getftime (afile, fdate);
  127.      close (afile);
  128.      unpacktime ( fdate, dtt );
  129.      dstr := '' ;
  130.      with dtt do begin
  131.           dstr := dstr + leadingzero ( month ) + '/' ;
  132.           dstr := dstr + leadingzero ( day ) + '/' ;
  133.           dstr := dstr + ( copy ( ( leadingzero ( year )), 3, 2 ));
  134.      end;
  135.      extract_file_date := dstr ;
  136. end;
  137.  
  138. function extract_file_time ( fname : string ) : string ;
  139. var
  140.     afile : file ;
  141.     ftime : longint ;
  142.     dtt   : datetime ;
  143.     tstr  : string ;
  144. begin
  145.      assign (afile, fname);
  146.      reset (afile);
  147.      getftime (afile, ftime);
  148.      close (afile);
  149.      unpacktime ( ftime, dtt );
  150.      tstr := '' ;
  151.      with dtt do begin
  152.           tstr := tstr + leadingzero ( hour ) + ':' ;
  153.           tstr := tstr + leadingzero ( min ) + ':' ;
  154.           tstr := tstr + leadingzero ( sec );
  155.      end;
  156.      extract_file_time := tstr ;
  157. end;
  158.  
  159. procedure stampfile ( fname : string ; ftime : longint );
  160. var
  161.    afile : file ;
  162. begin
  163.      assign (afile, fname);
  164.      reset (afile);
  165.      setftime (afile, ftime);
  166.      close (afile);
  167.      write ('.');
  168. end;
  169.  
  170. procedure todaysdate;
  171. var
  172.    dt : longint ;
  173. begin
  174.      get_dt ( dt );
  175.      while doserror = 0 do begin
  176.            stampfile ( dirinfo.name, dt );
  177.            findnext ( dirinfo );
  178.      end;
  179. end;
  180.  
  181. procedure justdate ( datestr : string );
  182. var
  183.    timestr : string ;
  184.    dt_int  : longint ;
  185. begin
  186.      parsedate ( datestr , dt_int );
  187.      while doserror = 0 do begin
  188.            timestr := extract_file_time ( dirinfo.name );
  189.            parsetime ( timestr , dt_int );
  190.            stampfile ( dirinfo.name , dt_int );
  191.            findnext ( dirinfo );
  192.      end;
  193. end;
  194.  
  195. procedure justtime ( timestr : string );
  196. var
  197.    datestr : string ;
  198.    dt_int  : longint ;
  199. begin
  200.      parsetime ( timestr , dt_int );
  201.      while doserror = 0 do begin
  202.            datestr := extract_file_date ( dirinfo.name );
  203.            parsedate ( datestr , dt_int );
  204.            stampfile ( dirinfo.name , dt_int );
  205.            findnext ( dirinfo );
  206.      end;
  207. end;
  208.  
  209. procedure newdate ( datestr, timestr : string );
  210. var
  211.    dt_int : longint ;
  212. begin
  213.      parsedate ( datestr , dt_int );
  214.      parsetime ( timestr , dt_int );
  215.      while doserror = 0 do begin
  216.            stampfile ( dirinfo.name , dt_int );
  217.            findnext ( dirinfo );
  218.      end;
  219. end;
  220.  
  221. var cent : string ;
  222.     vale : integer ;
  223.  
  224. begin
  225.      findfirst ( paramstr (1), archive, dirinfo );
  226.      if ( doserror <> 0) then
  227.           showhelp(1);
  228.      write ( 'Working ' );
  229.  
  230.      cent := getenv ( 'century' );
  231.      if cent = '' then cent := '1900' ;
  232.      val ( cent, century, vale );
  233.      if vale <> 0 then century := 1900 ;
  234.  
  235.      case paramcount of
  236.           1 : todaysdate;
  237.           2 : begin
  238.                  ps2 := paramstr ( 2 );
  239.                  if ((ps2 = '/p') or (ps2 = '/P')) then begin
  240.                     while ( length (ps2) < 8) do begin
  241.                        writeln ;
  242.                        writeln ('Enter a date in the format mm/dd/yy:');
  243.                        readln  (ps2);
  244.                     end;
  245.                     justdate (ps2);
  246.                  end
  247.                  else begin
  248.                     if (( length (ps2) = 4 )
  249.                      or ( length (ps2) = 7 )) then
  250.                        ps2 := '0'+ps2;
  251.                     if (( ps2[3] = '-' ) or
  252.                         ( ps2[3] = '/' )) then justdate ( ps2 )
  253.                     else justtime ( ps2 );
  254.                  end;
  255.               end;
  256.           3 : newdate ( paramstr (2), paramstr (3) );
  257.      else
  258.           showhelp(2);
  259.      end;   { case }
  260.  
  261.      writeln ( ' done!' );
  262. end.
  263.